home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / tpstuff2.arc / IOERROR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-12-02  |  2.9 KB  |  85 lines
  1.  
  2. {$I-,R-}
  3. program TestIOCheck;
  4. {
  5.        The routine IOCheck, along with the global declarations
  6.        IOFlag and IOErr, should be placed in any program where you
  7.        want to handle your own I/O error checking.
  8. }
  9. {***************************** Please Note **************************
  10.  
  11.        The main routine in this program is just a sample of what you
  12.        can do with TestIOCheck.  This sample simply assigns a new file
  13.        ReWrites it and then tries to read from it - which is illegal.
  14.        The error this routine generates is somewhat explanatory of what
  15.        error has actually occured.  Try it - and modify it.  It can be
  16.        a real added benifit to programs you write yourself using files!
  17.  
  18. *********************************************************************}
  19.  
  20. const
  21.   IOVal                : Integer = 0;
  22.   IOErr                : Boolean = False;
  23. var
  24.   InFile               : Text;
  25.   Line                 : string[80];
  26.  
  27. procedure IOCheck;
  28. {
  29.        This routine sets IOErr equal to IOresult, then sets
  30.        IOFlag accordingly.  It also prints out a message on
  31.        the 24th line of the screen, then waits for the user
  32.        to hit any character before proceding.
  33. }
  34. var
  35.   Ch                   : Char;
  36. begin
  37.   IOVal := IOresult;
  38.   IOErr := (IOVal <> 0);
  39.   GotoXY(1,24); ClrEol;        { Clear error line in any case }
  40.   if IOErr then begin
  41.     Write(Chr(7));
  42.     case IOVal of
  43.       $01  :  Write('File does not exist');
  44.       $02  :  Write('File not open for input');
  45.       $03  :  Write('File not open for output');
  46.       $04  :  Write('File not open');
  47.       $05  :  Write('Can''t read from this file');
  48.       $06  :  Write('Can''t write to this file');
  49.       $10  :  Write('Error in numeric format');
  50.       $20  :  Write('Operation not allowed on a logical device');
  51.       $21  :  Write('Not allowed in direct mode');
  52.       $22  :  Write('Assign to standard files not allowed');
  53.       $90  :  Write('Record length mismatch');
  54.       $91  :  Write('Seek beyond end of file');
  55.       $99  :  Write('Unexpected end of file');
  56.       $F0  :  Write('Disk write error');
  57.       $F1  :  Write('Directory is full');
  58.       $F2  :  Write('File size overflow');
  59.       $FF  :  Write('File disappeared')
  60.     else      Write('Unknown I/O error:  ',IOVal:3)
  61.     end;
  62.     Read(Kbd,Ch)
  63.   end
  64. end; { of proc IOCheck }
  65.  
  66. procedure PutLineNum(LineNum : Integer);
  67. {
  68.        This routine tells you which line is being executed,
  69.        so that you can see which statement is causing which
  70.        error.
  71. }
  72. begin
  73.   GotoXY(1,1); ClrEol;
  74.   Write('Executing line #',LineNum)
  75. end; { of proc PutLineNum }
  76.  
  77. begin
  78.   PutLineNum(1); Assign(InFile,'dummy');     IOCheck;
  79.   PutLineNum(2); Rewrite(InFile);            IOCheck;
  80.   PutLineNum(3); Read(Infile,Line);          IOCheck;
  81.   PutLineNum(4); Close(Infile);              IOCheck
  82. end. { of program TestIOCheck }
  83.  
  84.  
  85.